perm filename CCRMA.CHG[NEW,LCS]4 blob sn#552726 filedate 1980-12-23 generic text, type T, neo UTF8
*********** CHANGES SINCE MOVE TO CCRMA **********

NEWMRK.F4****************

	[SUBROUTINE DASHES(IX,R2,RD)]

2	SZ=RN(J+5)
	R5=SZ*RSTJ2
C R=REAL SIZE FACTOR FOR SPACE     RN(LFT+9) IS WIDTH OF GROUP TO LEFT.
	RP=R5*RN(J+9)+A
→→→	IF(RP.LT.0)RP=3.0
C RP=RIGHT SIDE OF LEFT CHAR. STRING.
	R3=RP
→→→	IF(B.GT.201)B=201.
	R6=B-R5*BSIZE
CC	RR6=R6
→→→	IF(R3.LT.0)R3=4.


10	R6=R6-RDZ
CC10	R6=R3+(RR3+A)*B-RR3-RDZ
	RD(6)=RR3
	RD(7)=A/RSTJ2
C P9(SPACE BETWEEN DASHES) REAL SIZE IS P9*RSTJ2
CCC	GO TO 4
CCC11	RD(5)=0
4	RD(2)=RN(J+4)+1.0-R5*0.5



MS.F4****************

→→→	5 ,PLUS/'+'/,EXT/'MS '/,COMMA/','/,FILNAM/'INIT'/
	DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/

710	IF(I2.NE.IXX)GO TO 715 
C TYPE 'NX' TO RESTART WITH NEXT ALPHABETICAL FILE NAME (ONLY 5TH LETTER THOUGH.)
	I1=LRR
	I2=LSS
	I4=PLUS
	GO TO 10
715	IF(QUICK.NE.0)GO TO 720


	IF(I2.NE.LDD)GO TO 1065
C FOR 'CD' CENTER DASHES
	JJ2=1
	GO TO 1785
1065	KNT=0
	SCORE=0
1070	KNT=KNT+1


1770	IF(I2.EQ.IBLA)GO TO 1780
	IF(I2.EQ.LDD)GO TO 1060
C NOW 'CD', WHEN NOT IN EDIT MODE = CENTER ALL DASHES ON A LINE. (USES GRED)
1780	CALL MOVER
	IF(R2.GE.99)GO TO 260
C   99(+)=BACKUP OUT OF MOVER ETC.
	JFONT=0
1785	IGO=0
C  SO IT WON'T DO ALL FONT LOOKUPS.
1790	IF(JJ2)GO TO 130


2260	CALL LO2UP(NAME)
	CALL LO2UP(EXT)
	IF(NAME.EQ.PLUS)NAME=NAMZ+2

2290	K=NAME
	NAMZ=K
C  SAVE THE NAME FOR '+' ROUTINE (GOES UP THE ALPHABET)
	IF(LOOKX(NAME,EXT).EQ.0)GO TO 2240

→→→	NAMZ=L
2310	RSTF=0



SLOOP.FAI****************

SLOOP:	0
→→→	SETZM CIX	;INITIALIZE HALF-SLUR FLAG


LOOP.FAI****************

BOX:	0    	;CALL BOX(I,R)   SEE PLTSRT.F4 FOR FORTR. VERSION
	MOVE IDEV
	CAIE 5
	JRST BX4-3	;UPDATE IOLD    JRA 16,2(16)	;IF(IDEV.NE.5)RETURN


WORDS.F4****************

	1 J4,L,Y,K,RX,RZ,RA,J5  /XRN/RN(1) /ALF/INP(1) /IDEV/IDEV
C12/80	1 J4,L,Y,K,RX,RZ,RA,J5  /XRN/RN(1) /ALF/INP(72),ML

431	FORMAT(100A1)
	IF(IDEV.NE.5)GO TO 131
	CALL TYPSTR('TYPE UP TO 100 CHARS--')
	CALL TYPCRL
131	READ(IDEV,431)(INP(KN),KN=1,100)
C12/80 131	CALL TYPE
C12/80 531	DO 31 KN=72,1,-1
C NOW 100 CHARACTERS ACCPTED IN 'TYPE' MODE
531	DO 31 KN=100,1,-1

317	ML=L
	DO 417 N=IA,KN
C12/80	IF(ML.LT.72)ML=ML+1
	IF(ML.LT.100)ML=ML+1

	IF(J2.GT.7)RETURN
C CATCH STAFF TYPO ERROR
	KNT=-1

317	ML=L
	DO 417 N=IA,KN
→→→	IF(ML.LT.72)ML=ML+1
C MAKE ABOVE MORE 'ELEGANT'


SLRSCL.F4****************

SUBROUTINE SETLET

	IF(IDEV.EQ.1)GO TO 44
	CALL DPYSET(3,SU,320)  [DELETE THESE ABOVE!!]
	CALL DPYBRT(6)
	DO 4 K=2,M
	R3=RHORZ(RPOS(1,K))
	CALL PNUM
	J5=J5+1
4	IF(J5.EQ.10)J5=0
	CALL DPYOUT(3)
	CALL SETPOG(1)
44	RPOS(1,M+1)=200

2267	IF(V(3).EQ.0.AND.IDEV.NE.1)GO TO 267
C WHEN TYPING, NOTE NUMS CAN BE ON 1 LINE IF THERE ARE >2.  (VERT. POS. MUST BE PRESET)


BEAMS.F4*****************

	SUBROUTINE BMREAD
	COMMON  /ALF/INP(72) /IDEV/IDEV
	CALL TYPE
C12/80	IF(IDEV.EQ.5)WRITE(21,4501)INP
	IF(IDEV.EQ.5)CALL INPOUT
C  WRITES OUT INPUT LINE.

SCMSS.F4********************

3377	CALL OFILE(21,NAMSC)
C12/80	WRITE(21,2114)INP
	CALL INPOUT
C WRITE OUT 'IN' ETC.

	IF(IDEV.EQ.5)CALL INPOUT
C12/80	IF(IDEV.EQ.5)WRITE(21,2114)INP
C WRITE OUT SPACING INFO
5333	CALL A2READ(K,RA)

80041	IF(IDEV.EQ.5)CALL INPOUT
C12/80  80041	IF(IDEV.EQ.5)WRITE(21,2114)INP

	IF(IDEV.EQ.5)CALL INPOUT
C12/80	IF(IDEV.EQ.5)WRITE(21,2114)INP
	CALL LULOOP
77732	CALL LNEND


RHYTH.F4 *********************

	(SUBROUTINE NOTNUM)
	CALL DPYSET(3,ST(3200),390)
C LOCATION 3200 IN ST COULD BE IN USE IF MUCH DATA ON SCREEN. (DOESN'T MATTER)


GREDX.F4*************

SUBROUTINE GRED

	COMMON /MKX/KSLA,ISEMI,LESS,IGT
	1/A2Z/LAA,LBB,LCC,LDD,NONO(7),LEL,LMM,LNN,NON(9),LXX

4	JA=98
C  DEL=FOR DELETIONS   CD=CENTER DASHES BETWEEN SYLLABLES.
	IF(I2.EQ.LDD)JA=0

	IF(I2.NE.LDD)GO TO 71
C NEXT FOR 'CD'  CENTER DASHES WITH TEXT
	IF(RB.NE.4.)GO TO 6
	IF(RN(JY).LT.8.)GO TO 6
C P10 MUST BE .GT.0
	CALL DASHES(ITEM,RN(JY+2),RN(JY+3))
	GO TO 6

71	IF(V(1).EQ.12)GO TO 77
	IF(V(1).EQ.100)GO TO 341
C USE P100 AND ANY CODE# TO CREATE CUES. I.E. MINI NOTES, RESTS, BEAMS.
	IF(RC.EQ.999)GO TO 143
C  USE P12 TO INVERT STEM, BEAM AND SLURS ALL AT ONCE.
C  SET 12 TO 1 WITH CODE 5 TO INVERT SLURS ONLY
77	RC=0
	IF(RB.EQ.5)GO TO 141
	IF(RB.NE.6)GO TO 143
	IF(RX.EQ.1)GO TO 141
143	IF(RX.NE.44.)GO TO 144
C USE CODE 44 FOR ALL 'LINE' EXCEPT BARLINES.
	IF(RB.NE.4)GO TO 6
	IF(RN(JY).LE.2)GO TO 6
	GO TO 100
144	IF(RB.NE.RX.AND.RX.NE.0)GO TO 6
CXX	IF(ASK)GO TO 100
CXX	CALL ASKIT
CXX	IF(K.EQ.LNN)GO TO 6
CXX	IF(K.EQ.LXX)GO TO 19
100	IF(INP(1).EQ.LAA)GO TO 141


****** JUSTFY.F4

	IF(RN(L+8).NE.0)GO TO 250
C P8=-1 MEANS WHOLE MEASURE REST (NEVER DOT, P6 CAN HAVE NUMB.)
C P8=POS MEANS WHOLE MEASURE REST WITH NUMBER.
44	IF(RL.GE.4)RB=RN(L+6)*1.5


CODE4.FAI**********

	SKIPG .COMM.+=10   ;	26420	      IF(R9.LE.0)RZ=RJ
      	MOVEM 	02,ALF+=18    
;26430	  P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)

PAGE*******
TRNSP.F4*********
 SUBR. RVRS

CCC	IF(Q(J+5).LT.10)GO TO 10
	IF(Q(J+5).LT.10)GO TO 202
C  JUMP IF NO STEM ON IT
	IF(Q(J+8).GT.999.)GO TO 202
	B=Q(J)
	IF(B.GT.7.AND.Q(J+10).NE.0)GO TO 202
C  JUMP IF GRACE NOTE (P8=1000 OR P10=-1) OR ON ANOTHER STAFF.
	IF(B.GT.6.AND.Q(J+9).LT.0)GO TO 202
C SKIP NOTES WITH NO LEDGER LINES
	KK=K+1
3	IF(KK.GT.LEND)GO TO 102

********* PLOT3.FAI *********

PL1:	MOVE 4,LX
	. . . .
	MOVE 7,4		;AC5 HAS REMAINDER
	SKIPE 5		;DON'T SUBTRACT IF AC5 IS ALREADY 0
	SOJ 5,			;LESS 1 BECAUSE . . . . .